Rem Project: Text3D
Rem Created: 12/04/2005 23:51:59
Rem ***** Main Source File *****
sync on:autocam off:backdrop on:color backdrop rgb(10,10,10)
`Initialise the D3Dfunc dll
D3D_Init


sh=screen height()
sw=screen width()
crlf$=chr$(13)+chr$(10)

D3D_Font 1,"Arial",20,0,0,1
D3D_Font 2,"Arial",15,0,0,1
D3D_Font 3,"Arial",10,0,0,1

gosub CenterWindow

do

    D3D_Box 0,5,sw/2,70,d3d_rgba(0,0,200,50),d3d_rgba(0,0,200,255),d3d_rgba(0,0,200,50),d3d_rgba(0,0,200,255)
    D3D_Box sw/2,5,sw,70,d3d_rgba(0,0,200,255),d3d_rgba(0,0,200,50),d3d_rgba(0,0,200,255),d3d_rgba(0,0,200,50)
    D3D_Line 0,5,sw,5,rgb(128,128,128)
    D3D_Line 0,70,sw,70,rgb(128,128,128)
    D3D_StartText
       D3D_Text 1,sw/2,10,1,"D3DFunc - Showcase"
       D3D_Text 2,sw/2,40,1,"Jason Clogg - 2008"
    D3D_EndText

    D3D_StartText
       d3d_rounded_box sw/2-300,95,sw/2+300,275,10,0,rgb(255,255,255)
       DisplayText$="(1) Antialiased text vs Normal text"+crlf$
       DisplayText$=DisplayText$+"(2) Antialiased text vs Normal text using multiple fonts"+crlf$
       DisplayText$=DisplayText$+"(3) 3D Text"+crlf$
       DisplayText$=DisplayText$+"(4) 3D Line Drawing"+crlf$
       DisplayText$=DisplayText$+"(5) Primitive Creation"+crlf$
       DisplayText$=DisplayText$+"(6) Polygon Drawing"+crlf$
       DisplayText$=DisplayText$+"(7) Polygon Drawing"+crlf$
       DisplayText$=DisplayText$+"(ESC) Quit Demo"+crlf$
       D3D_BoxText 3,sw/2-200,100,400,130,1,1,DisplayText$,rgb(255,255,255)

       d3d_rounded_box sw/2-200,295,sw/2+200,460,10,0,rgb(255,255,255)

       D3D_Text 2,sw/2,300,1,"Example of AA text alignment",rgb(255,255,255)

       Width=D3D_GetTextWidth (2,"0=Left Aligned")
       Height=D3D_GetTextHeight (2,"0=Left Aligned")
       D3D_box sw/2,330,sw/2+Width,330+Height,rgb(255,0,0)
       D3D_Text 2,sw/2,330,0,"0=Left Aligned",rgb(255,255,255)

       Width=D3D_GetTextWidth (2,"1=Centered")
       Height=D3D_GetTextHeight (2,"1=Centered")
       D3D_box sw/2-(Width/2),377,sw/2+(Width/2),377+(Height),rgb(255,0,0)
       D3D_Text 2,sw/2,377,1,"1=Centered",rgb(255,255,255)

       Width=D3D_GetTextWidth (2,"2=Right Aligned")
       Height=D3D_GetTextHeight (2,"2=Right Aligned")
       D3D_box sw/2-Width,428,sw/2,428+(Height),rgb(255,0,0)
       D3D_Text 2,sw/2,428,2,"2=Right Aligned",rgb(255,255,255)

       d3d_rounded_box sw/2-250,480,sw/2+250,580,10,1,rgb(0,0,255)
       d3d_rounded_box sw/2-250,480,sw/2+250,580,10,0,rgb(255,255,255)

       DisplayText$="This is text displayed by D3D_BoxText." +crlf$
       DisplayText$=DisplayText$+"It enables you to display text within a defined boundary."

       d3d_BoxText 2,sw/2-250,480,500,100,1,1,DisplayText$,rgb(255,255,255)
    D3D_EndText
       d3d_line sw/2,330,sw/2,450,rgb(255,255,255)
    if inkey$()="1" then gosub AntiVsText
    if inkey$()="2" then gosub AntiVsTextMulti
    if inkey$()="3" then gosub TextMesh
    if inkey$()="4" then gosub 3DLineDraw
    if inkey$()="5" then gosub PyramidCreation
    if inkey$()="6" then gosub PolygonDrawing
    `if upper$(inkey$())="Q" then end
    sync
loop

AntiVsText:

   Rem D3D_Font for Antialiased Text and 3D Text commands - Format is Font number Font Name,size,bold(0 or 1),italic(0 or 1)
   D3D_Font 1,"Arial",9,0,0,1
   D3D_Font 2,"Comic Sans MS",15,0,0,1
   set text font "Arial"
   set text size 15
   textmode=1
   do
      if textmode=1
         text 0,0,"Normal Text Text - FPS="+str$(screen fps())
         text 0,15,"Press space to toggle test, 'q' to quit to menu"
         for i=1 to 200
            text rnd(610)+20,rnd(470)+50,"Test Text String"
         next i
      else
         D3D_StartText
            D3D_Text 1,0,0,0,"Antialiased Text Text - FPS="+str$(screen fps())
            D3D_Text 1,0,15,0,"Press space to toggle test, 'q' to quit to menu"
            for i=1 to 200
               D3D_Text 2,rnd(610)+20,rnd(470)+50,0,"Test Text String"
            next i
         D3D_EndText
      endif

      if spacekey()=1
         if spacepressed=0
            spacepressed=1
            if textmode=1 then textmode=0 else textmode=1
         endif
      else
         spacepressed=0
      endif

      if upper$(inkey$())="Q"
         D3D_Font 1,"Arial",20,0,0,1
         D3D_Font 2,"Arial",15,0,0,1
         D3D_Font 3,"Arial",10,0,0,1
         return
      endif

      sync

   loop

   return

AntiVsTextMulti:

   cls 0

   D3D_Font 1,"Arial",9,0,0,1
   D3D_Font 2,"Tahoma",15,0,0,1
   D3D_Font 3,"Comic Sans MS",25,0,0,1
   D3D_Color 255,0,0,255
   ink rgb(255,0,0),0
   textmode=1
   do
      if textmode=1
         set text font "Arial"
         set text size 15
         text 0,0,"Normal Text Text - FPS="+str$(screen fps())
         text 0,15,"Press space to toggle test, 'q' to quit to menu"
         for i=1 to 5
            set text font "Tahoma"
            set text size 25
            text rnd(550)+20,rnd(470)+50,"Test Text String"
            set text font "Comic Sans MS"
            set text size 42
            text rnd(550)+20,rnd(470)+50,"Test Text String"
         next i
      else
         D3D_StartText
         D3D_Text 1,0,0,0,"Antialiased Text Text - FPS="+str$(screen fps())
         D3D_Text 1,0,15,0,"Press space to toggle test, 'q' to quit to menu"
         for i=1 to 200
            D3D_Text 2,rnd(550)+20,rnd(470)+50,0,"Test Text String"
            D3D_Text 3,rnd(550)+20,rnd(470)+50,0,"Test Text String"
         next i
         D3D_EndText
      endif
      if spacekey()=1
         if spacepressed=0
            spacepressed=1
            if textmode=1 then textmode=0 else textmode=1
         endif
      else
         spacepressed=0
      endif
      if upper$(inkey$())="Q"
         D3D_Font 1,"Arial",20,0,0,1
         D3D_Font 2,"Arial",15,0,0,1
         D3D_Font 3,"Arial",10,0,0,1
         return
      endif

      sync

   loop
   return

TextMesh:

   cls
   color backdrop rgb(10,10,10)
   set camera view 0,0,sw/2,sh/2

   make camera 1
   color backdrop 1,rgb(40,0,0)
   set camera view 1,sw/2,0,sw,sh/2

   make camera 2
   color backdrop 2,rgb(0,40,0)
   set camera view 2,0,sh/2,sw/2,sh

   make camera 3
   color backdrop 3,rgb(0,0,40)
   set camera view 3,sw/2,sh/2,sw,sh

   do
      text$=InputText(0,0,"Enter text to be converted to a mesh : ","Text3D")
      font$=InputText(0,0,"Enter font to use : ","Arial")
      depth#=val(InputText(0,0,"Enter object depth : ",".1"))
      quality=val(InputText(0,0,"Enter object quality(0-low,1-medium,2-high) : ","2"))
      alignment=val(InputText(0,0,"Enter mesh alignment(0-left,1-center,2-right,3-font origin : ","1"))
      D3D_Font 1,font$,15,0,0,1
      D3D_Make_3DText 1, 1,text$,depth#,quality,alignment
      position object 1,0,0,0
      color object 1,rgb(255,0,0)
      ca#=0
      while spacekey()=0
         text 0,0,"3D Text Demonstration - FPS="+str$(screen fps())+" - polygons="+str$(statistic(1))
         text 0,15,"Press Space to create another object"
         text 0,30,"Press 'q' to quit to menu"
         cx#=cos(ca#)*5
         cz#=sin(ca#)*5
         position camera cx#,2,cz#
         point camera 0,0,0
         position camera 1,cx#*.5,2,cz#*.5
         point camera 1,0,0,0
         position camera 2,cx#*.75,-2,cz#*.75
         point camera 2,0,0,0
         position camera 3,cx#*1.25,3,cz#*1.25
         point camera 3,0,0,0
         ca#=ca#+.1
         if upper$(inkey$())="Q"
            set text font "Arial"
            set text size 15
            ink rgb(255,255,255),0
            delete object 1
            delete camera 1
            delete camera 2
            delete camera 3
            set camera view 0,0,1024,768
            return
         endif
         d3d_Line sw/2,0,sw/2,sh,rgb(128,128,128)
         d3d_Line 0,sh/2,sw,sh/2,rgb(128,128,128)
         sync
      endwhile
      delete object 1
   loop

   D3D_Font 1,"Arial",20,0,0,1
   D3D_Font 2,"Arial",15,0,0,1
   D3D_Font 3,"Arial",10,0,0,1

   return

3DLineDraw:

   cls
   ca#=0
   for i=1 to 20
      if object exist(i+100)=0 then  make object sphere i+100,.5
      hide object i+100
   next i
   zpos#=50
   x=0
   y=0
   set text opaque
   color backdrop rgb(10,10,10)
   set camera view 0,0,sw/2,sh/2

   make camera 1
   color backdrop 1,rgb(40,0,0)
   set camera view 1,sw/2,0,sw,sh/2

   make camera 2
   color backdrop 2,rgb(0,40,0)
   set camera view 2,0,sh/2,sw/2,sh

   make camera 3
   color backdrop 3,rgb(0,0,40)
   set camera view 3,sw/2,sh/2,sw,sh
   do
      text 0,0,"3D Line Demonstration - FPS="+str$(screen fps())
      text 0,15,"Press 'q' to quit to menu"
      cx#=cos(ca#)*zpos#
      cz#=sin(ca#)*zpos#
      position camera cx#,2,cz#
      point camera 0,0,0
      position camera 1, cx#,2,cz#
      point camera 1,0,0,0
      position camera 2, cx#,2,cz#
      point camera 2,0,0,0
      position camera 3, cx#,2,cz#
      point camera 3,0,0,0
      ca#=ca#+.1
      randomize 0
      x1#=rnd(20)-5
      y1#=rnd(20)-5
      z1#=rnd(20)-5
      for i=1 to 20
         x2#=rnd(20)-5
         y2#=rnd(20)-5
         z2#=rnd(20)-5
         position object i+100,x1#,y1#,z1#
         show object i+100
         LineColor=D3D_RGBA(rnd(255),rnd(255),rnd(255),255)
         D3D_Line3D x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
         D3D_Line3D 1,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
         D3D_Line3D 2,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
         D3D_Line3D 3,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
         D3D_Dot3D x1#,y1#,z1#,5,LineColor, 0
         D3D_Dot3D 1,x1#,y1#,z1#,5,LineColor, 0
         D3D_Dot3D 2,x1#,y1#,z1#,5,LineColor, 0
         D3D_Dot3D 3,x1#,y1#,z1#,5,LineColor, 0
         x1#=x2#
         y1#=y2#
         z1#=z2#
      next i
      if zpos#=>50 then zmove#=-.01
      if zpos#=<-50 then zmove#=.01
      zpos#=zpos#+zmove#
      if upper$(inkey$())="Q"
         for i=1 to 20
            hide object i+100
         next i
         set camera view 0,0,screen width(),screen height()
         cls 0
         set text font "Arial"
         set text size 15
         ink rgb(255,255,255),0
         delete object 1
         delete camera 1
         delete camera 2
         delete camera 3
         set camera view 0,0,1024,768
         return
      endif
      sync
   loop

   D3D_Font 1,"Arial",20,0,0,1
   D3D_Font 2,"Arial",15,0,0,1
   D3D_Font 3,"Arial",10,0,0,1

   return

PyramidCreation:

   cls
   iPrimitive=0
   spacepressed=0
   Do
      Select iPrimitive
         Case 0
            D3D_Make_Pyramid 1, 3, 3, 3
            Obj$="Pyramid"
         EndCase
         Case 1
            D3D_Make_Teapot 1
            Obj$="Teapot"
         EndCase
         Case 2
            D3D_Make_Torus 1,.5,.8,32,32
            Obj$="Torus"
         EndCase
         Case 3
            D3D_Make_Polygon 1,6
            Obj$="Polygon"
         EndCase
      EndSelect
      ExitLoop=0
      While ExitLoop = 0
         text 0,0,"Primitive Demonstration - FPS="+str$(screen fps())+" - polygons="+str$(statistic(1))
         text 0,15,"Press Space to create another object"
         text 0,30,"Press 'q' to quit to menu"
         cx#=cos(ca#)*5
         cz#=sin(ca#)*5
         position camera cx#,2,cz#
         point camera 0,0,0
         ca#=ca#+.1
         if upper$(inkey$())="Q"
            set text font "Arial"
            set text size 15
            ink rgb(255,255,255),0
            delete object 1
            return
         endif

         if spacekey()=1
            if spacepressed=0
               spacepressed=1
               ExitLoop=1
            endif
         else
            spacepressed=0
         endif

         if upper$(inkey$())="Q"
            ExitLoop=2
         endif

         D3D_StartText
            D3D_Text 2,sw/2,100,1,Obj$,rgb(255,255,255)
         D3D_EndText
         
         sync
      EndWhile
      
      Delete Object 1
      inc iPrimitive
      
      if iPrimitive>3 then iPrimitive=0
      
      if ExitLoop=2
         D3D_Font 1,"Arial",20,0,0,1
         D3D_Font 2,"Arial",15,0,0,1
         D3D_Font 3,"Arial",10,0,0,1
         return
      Endif
      
   Loop
return

PolygonDrawing:

   cls
   cwa#=0
   ccwa#=0
   do
      text 0,0,"Polygon Demonstration - FPS="+str$(screen fps())
      text 0,15,"Press 'q' to quit to menu"

      tmrRotation=timer()
      
      Rem Each Polygon is drawn twice, first filled, then outlined
      
      d3d_polygon sw/4,sh/4,50,3,1,cwa#,rgb(255,0,0)
      d3d_polygon sw/4,sh/4,50,3,0,cwa#,rgb(255,255,255)
      
      d3d_polygon sw/2,sh/4,50,4,1,ccwa#,rgb(255,0,0)
      d3d_polygon sw/2,sh/4,50,4,0,ccwa#,rgb(255,255,255)

      d3d_polygon sw/4*3,sh/4,50,5,1,cwa#,rgb(255,0,0)
      d3d_polygon sw/4*3,sh/4,50,5,0,cwa#,rgb(255,255,255)

      d3d_polygon sw/4,sh/2,50,3,1,cwa#,rgb(0,255,0)
      d3d_polygon sw/4,sh/2,50,3,0,cwa#,rgb(255,255,255)

      d3d_polygon sw/2,sh/2,50,5,1,ccwa#,rgb(0,255,0)
      d3d_polygon sw/2,sh/2,50,5,0,ccwa#,rgb(255,255,255)

      d3d_polygon sw/4*3,sh/2,50,6,1,cwa#,rgb(0,255,0)
      d3d_polygon sw/4*3,sh/2,50,6,0,cwa#,rgb(255,255,255)

      d3d_polygon sw/4,sh/4*3,50,7,1,cwa#,rgb(0,0,255)
      d3d_polygon sw/4,sh/4*3,50,7,0,cwa#,rgb(255,255,255)

      d3d_polygon sw/2,sh/4*3,50,8,1,ccwa#,rgb(0,0,255)
      d3d_polygon sw/2,sh/4*3,50,8,0,ccwa#,rgb(255,255,255)

      d3d_polygon sw/4*3,sh/4*3,50,9,1,cwa#,rgb(0,0,255)
      d3d_polygon sw/4*3,sh/4*3,50,9,0,cwa#,rgb(255,255,255)

      if upper$(inkey$())="Q"
         D3D_Font 1,"Arial",20,0,0,1
         D3D_Font 2,"Arial",15,0,0,1
         D3D_Font 3,"Arial",10,0,0,1
         return
      endif

      Rem Rotate each polygon 360 degrees every 2 seconds (2000ms)
      
      cwa#=wrapvalue((tmrRotation mod 2000)*360.0/2000.0)
      ccwa#=wrapvalue((2000-(tmrRotation mod 2000))*360.0/2000.0)
      sync

   loop

return

CenterWindow:

Rem Get Desktop Size

DW=D3D_Get_Desktop_Width()
DH=D3D_Get_Desktop_Height()

Rem Not completely accurate but should be good enough
set window position DW/2-SW/2,DH/2-SH/2-32

return

function InputText(x,y,Message$,default$)
   set text font "Arial"
   set text size 15
   ink rgb(255,255,255),0
   text$=default$
   clear entry buffer
   do
      text x,y,Message$+text$
      buf$=entry$():clear entry buffer
      for i=1 to len(buf$)
         select asc(mid$(buf$,i))
            case 8
               text$=left$(text$,len(text$)-1)
            endcase
            case 13
               exitfunction text$
            endcase
            case default
               text$=text$+mid$(buf$,i)
            endcase
         endselect
      next i
      sync
   loop
endfunction ""